home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / MacPerl ƒ / lib / StandardFile.pl < prev    next >
Perl Script  |  1994-01-05  |  3KB  |  110 lines
  1. #!/usr/bin/perl
  2. # StandardFile.pl
  3. # Standard File Package Utility for MacPerl 4.1.1
  4. #
  5. # 1994.01.05 v4.1.1 Matthias Neeracher <neeri@iis.ee.ethz.ch>
  6. #  Minor changes to reflect future plans for standard file support.
  7. #
  8. # 1993.10.27 v1.2    wm
  9. #    Change the calling syntax to adopt the 4.1.0 release.
  10. #    
  11. # 1993.10.19 v1.1    wm
  12. #    convert for 4.1b6
  13. #
  14. # 1993.8.10  V1.0
  15. #     Watanabe Maki (Watanabe.Maki@tko.dec.com)
  16. #
  17.  
  18. require "GUSI.ph";
  19.  
  20. package StandardFile;
  21.  
  22. # Name
  23. #   GetFile
  24. # Syntax
  25. #   $filename = &GetFile([$prompt, ] @types [, $default]);
  26. # Description
  27. #   Query a existing file name to user by Standard File Dialog Box.
  28. #   $prompt is a user prompt, which is ignored under 4.1.1, but will 
  29. #   probably be shown in a future version. $prompt should never be a 
  30. #   string of length 4.
  31. #   @types is a list of the file type which is used for
  32. #   filtering the file list in the dialog box.
  33. #
  34. sub GetFile {
  35.     local($prompt,@types) = @_;
  36.      local($default) = pop(@types);
  37.      
  38.      if (length($prompt) == 4) {
  39.           unshift(@types, $prompt);
  40.         $prompt = "";
  41.     }
  42.      if (length($default) == 4) {
  43.           push(@types, $default);
  44.         undef $default;
  45.     }
  46.      
  47.     &MacPerl'Choose(
  48.         &GUSI'AF_FILE,          # domain
  49.         0,                      # type
  50.         $prompt,                # prompt
  51.         &GUSI'pack_sa_constr_file(@types),
  52.                                   # constraint
  53.         ($default ? &GUSI'CHOOSE_DEFAULT : 0),    
  54.                                             # flag 
  55.         $default                # default filename
  56.         );
  57. }
  58.  
  59. # Name
  60. #    PutFile/GetNewFile
  61. # Syntax
  62. #    $filename = &PutFile($prompt [, $default]);
  63. #    $filename = &GetNewFile($prompt [, $default]);
  64. # Description
  65. #    Query a new file name to user by Standard File Dialog Box.
  66. #    $prompt is a prompt sting on the dialog box.
  67. #    $default is a default file name.
  68. #
  69. sub PutFile {
  70.     local($prompt, $default) = @_;
  71.     
  72.     &MacPerl'Choose(
  73.         &GUSI'AF_FILE,         # domain
  74.         0,                     # type
  75.         $prompt,               # prompt
  76.         "",                    # constraint
  77.         &GUSI'CHOOSE_NEW + ($default ? &GUSI'CHOOSE_DEFAULT : 0),    
  78.                                            # flag 
  79.         $default               # default filename
  80.         );
  81. }
  82.  
  83. sub GetNewFile {
  84.     &PutFile;
  85. }
  86.  
  87. # Name
  88. #    GetFolder
  89. # Syntax
  90. #    $foldername = &GetFolder($prompt [, $default]);
  91. # Description
  92. # Query a folder name to user by Standard File Dialog Box.
  93. # $default is the default dialog
  94. #
  95. sub GetFolder {
  96.     local($prompt, $default) = @_;
  97.     
  98.     &MacPerl'Choose(
  99.         &GUSI'AF_FILE,          # domain
  100.         0,                      # type
  101.         $prompt,                # prompt
  102.         "",                     # constraint
  103.         &GUSI'CHOOSE_DIR + ($default ? &GUSI'CHOOSE_DEFAULT : 0),
  104.                                   # flag
  105.           $default
  106.         );
  107. }
  108.  
  109. 1;
  110.